home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CICA 1995 August
/
CICA - The Ultimate Collection of Shareware for Windows (Disc 2) (August 1995).iso
/
disc2
/
programr
/
vbasic
/
health.exe
/
ASSESS3.FRM
< prev
next >
Wrap
Text File
|
1993-07-23
|
9KB
|
268 lines
VERSION 2.00
Begin Form assess3
BorderStyle = 0 'None
Caption = "Form4"
ClientHeight = 5010
ClientLeft = 1020
ClientTop = 1425
ClientWidth = 7650
ForeColor = &H000000C0&
Height = 5415
Left = 960
LinkMode = 1 'Source
LinkTopic = "Form4"
ScaleHeight = 5010
ScaleWidth = 7650
Tag = "physical"
Top = 1080
Width = 7770
Begin PictureBox Picture3
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 615
Left = 600
ScaleHeight = 615
ScaleWidth = 2175
TabIndex = 7
Top = 4200
Visible = 0 'False
Width = 2175
End
Begin PictureBox Picture2
BorderStyle = 0 'None
Height = 2655
Left = 0
Picture = ASSESS3.FRX:0000
ScaleHeight = 2655
ScaleWidth = 7215
TabIndex = 4
Top = 600
Visible = 0 'False
Width = 7215
End
Begin PictureBox Picture1
BorderStyle = 0 'None
DrawWidth = 2
Height = 3735
Left = 480
ScaleHeight = 3735
ScaleWidth = 6255
TabIndex = 0
Top = 120
Width = 6255
Begin CheckBox Check1
Caption = " O=Other"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 375
Left = 1920
TabIndex = 6
Top = 3000
Width = 2415
End
Begin AniPushButton AniButton3
BackColor = &H00FFFFFF&
Cycle = 2 '2-state 1/2 & 1/2
Height = 480
Index = 0
Left = 3600
PictDrawMode = 1 'Autosize control
Picture = ASSESS3.FRX:4B43A
TabIndex = 5
Top = 120
Width = 480
End
Begin AniPushButton AniButton2
BackColor = &H00FFFFFF&
Caption = " "
Height = 480
Left = 3000
Picture = ASSESS3.FRX:4BA1C
Speed = 162
TabIndex = 3
TextPosition = 2 'Left
Top = 120
Width = 465
End
Begin AniPushButton AniButton1
BackColor = &H00FFFFFF&
Caption = "Next Page"
Height = 615
Index = 0
Left = 4320
Picture = ASSESS3.FRX:4BFFE
Speed = 162
TabIndex = 2
TextPosition = 2 'Left
Top = 0
Width = 1455
End
Begin AniPushButton AniButton1
BackColor = &H00FFFFFF&
Caption = "Back Page"
Height = 615
Index = 1
Left = 0
Picture = ASSESS3.FRX:4CEAA
Speed = 162
TabIndex = 1
TextPosition = 1 'Right
Top = 0
Width = 1455
End
End
End
Dim drawok, locked As Integer
Sub AniButton1_Click (Index As Integer)
If smartform(5) Then
Select Case Index
Case 1
medhist.Show
assess3.Hide
Case 0
MDIMForm.Show
MDIChild1C.Move 0, 0, MDIMForm.ScaleWidth, MDIMForm.ScaleHeight
MDIChild1B.Move 0, 360, MDIMForm.ScaleWidth, MDIMForm.ScaleHeight
MDIChild1A.Move 0, 720, MDIMForm.ScaleWidth, MDIMForm.ScaleHeight
assess3.Hide
End Select
Else
formcheck "Identifying Marks"
End If
End Sub
Sub AniButton2_Click ()
If smartform(5) Then
menumode assess3
Else
formcheck "Identifying Marks"
End If
End Sub
Sub AniButton3_Click (Index As Integer)
Select Case anibutton3(0).Value
Case 1
picloc = 0 ' for smartform
locked = 0
msg$ = " Clear the Drawing?"
x% = MsgBox(msg$, 4, "IDENTIFYING MARKS")
If x% = 6 Then
screen.MousePointer = 11
Picture1.Picture = Picture2.Picture
msg$ = "Indicate Location"
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.CurrentY = Picture1.ScaleHeight - 13 * (TextHeight(msg$))
Picture1.Print msg$
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.Print "S=Scars"
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.Print "B=Bruises"
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.Print "R=Rashes"
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
'******************************************************
check1.Visible = -1
screen.MousePointer = 0
End If
Case 2
picloc = -1 ' for smartform
locked = -1
check1.Visible = 0
msg$ = "Indicate Location"
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.CurrentY = Picture1.ScaleHeight - 13 * (TextHeight(msg$))
Picture1.Print msg$
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.Print "S=Scars"
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.Print "B=Bruises"
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.Print "R=Rashes"
y = Picture1.CurrentY
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.Line (Picture1.CurrentX, Picture1.CurrentY)-Step(TextWidth("Indicate Location") * 1.1, TextHeight(msg$) * 1.3), QBColor(15), BF
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.CurrentY = y
Picture1.Print LTrim$(check1.Caption)
screen.MousePointer = 11
bounce2 assess3.Picture1, assess3.Picture3
screen.MousePointer = 0
Picture1.Picture = Picture3.Image
End Select
End Sub
Sub Check1_Click ()
If check1.Value Then
BEditform.Label1.Tag = " Enter Other Injuries And Marks"
BEditform.Command2.Tag = " Re-Enter Other Marks"
BEditform.Show 1
End If
End Sub
Sub Form_Load ()
Picture1.ForeColor = &H0&
Picture1.FontSize = 12
assess3.Move 0, 0, screen.Width, screen.Height
Picture1.Move 0, 0, assess3.ScaleWidth, assess3.ScaleHeight
Picture2.Move 0, 0, assess3.ScaleWidth, assess3.ScaleHeight
Picture3.Move 0, 0, assess3.ScaleWidth, assess3.ScaleHeight
anibutton1(0).Move Picture1.Width - anibutton1(0).Width * 1.1, Picture1.Height - anibutton1(0).Height * 1.1
anibutton1(1).Move 0, Picture1.Height - anibutton1(0).Height * 1.1
anibutton2.Move (Picture1.Width - anibutton2.Width) / 2, Picture1.Height - anibutton2.Height * 1.3
anibutton3(0).Move (anibutton2.Width * 1.3 + anibutton2.Left), Picture1.Height - anibutton2.Height * 1.3
assess3.Picture1.Picture = assess3.Picture2.Picture
Picture1.AutoRedraw = -1
msg$ = "Indicate Location"
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.CurrentY = Picture1.ScaleHeight - 13 * (TextHeight(msg$))
Picture1.Print msg$
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.Print "S=Scars"
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.Print "B=Bruises"
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.Print "R=Rashes"
Picture1.CurrentX = (Picture1.ScaleWidth - TextWidth(msg$)) / 2
Picture1.AutoRedraw = 0
check1.Move Picture1.CurrentX, Picture1.CurrentY
Picture1.AutoRedraw = 0 '*****
End Sub
Sub Picture1_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
Picture1.CurrentX = x
Picture1.CurrentY = y
drawok = -1
End Sub
Sub Picture1_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
If drawok And Not locked Then Picture1.Line -(x, y)
End Sub
Sub Picture1_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
drawok = 0
End Sub